COMMENT ⊗   VALID 00014 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	SCENE - cross-reference  mapping schemes
 00008 00003	_ LCOMCV
 00010 00004	_ XREF
 00012 00005	_ XREF cont
 00014 00006	_ XREF cont
 00016 00007	_ XREF cont
 00018 00008	_ XREF cont
 00020 00009	_ XREF cont
 00023 00010	_ XREF cont
 00025 00011	_ XREF cont
 00028 00012	_ XREF cont
 00031 00013	_ XREF cont
 00032 00014	_ UNXREF
 00034 ENDMK
⊗;
COMMENT SCENE - cross-reference  mapping schemes;

ENTRY LCOMCV,XREF,UNXREF;

BEGIN "SCENE"

DEFINE QI="INTEGER",
	QR="REAL",
	QRI="REFERENCE INTEGER",
	QRR="REFERENCE REAL",
	QEP="EXTERNAL SIMPLE PROCEDURE",
	QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
	QERP="EXTERNAL SIMPLE REAL PROCEDURE",
	QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
	QFOIP="FORWARD INTERNAL SIMPLE INTEGER PROCEDURE",
	QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
	_="COMMENT",
	LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
	SAFEX="SAFE";

INTEGER IA,IB,IC,ID,IE,LNCS1,LNCS2;
EXTERNAL INTEGER IFREEV,MAXNOL,MAXNOV,LNCRE1,LNCRE2;

EXTERNAL REAL RWIC,RMLE,RCDI,RMALS,RMRLS;

SAFEX EXTERNAL INTEGER ARRAY LVERSI,LVERCO,LVER,IPK,IPS,LTJOIN,LINK[1:1];

SAFEX EXTERNAL REAL ARRAY XVCOR,YVCOR,SVANG,XLCOR,YLCOR,RK,RBK,RAS,RBS,
	RCOL,RLEN[1:1];

QEIP ISIGN(QI I,J);
QEIP LVNEXT(QI I,J);
QEIP LVOPP(QI I);
QEIP MERCV(QI I,J,K);
QEIP NLINCV(QI I);
QEIP LACT(QI I);
QEIP BELCRE(QI I);
QEIP KARN(QR X1,Y1,X2,Y2,X3,Y3,X4,Y4; QRR X,Y;
	  QRI IX1,IX2,IP1,IP2; QRR R1,R2; QI IC; QR WI);
QEP PLDIS(QR X,Y; QI I; QRR XL,YL,R; QRI IW);
QERP LDIST(QR X,Y; QI I);
QEIP NEXVER;
QEP RETCV(INTEGER ICV);
_ LCOMCV;

_	Returns number of common line, or 0 if no such line.
	Counts all types and connections.;

INTERNAL SIMPLE INTEGER PROCEDURE LCOMCV(INTEGER ICV1,ICV2);
	BEGIN "LCOMCV"
	LABEL L1;
	INTEGER ISV;
	ISV←ABS LVNEXT(ICV1,8);
L1:	IF ISV=0 THEN RETURN(0);
	IF LACT((ISV+1)%2)∧LVERCO[LVOPP(ISV)]=ICV2 THEN RETURN((ISV+1)%2);

_	No, this line is inactive or not common to ICV1 and ICV2, iterate.;

	ISV←ABS LVNEXT(0,8);
	GO L1;
	END "LCOMCV";
_ XREF;

_	Sets up cross-reference tables, based on line intersections,
	and uses those tables as a basis for the creation of temporary
	compound vertices. Those will later be utilized in the object
	abstraction schemes. Collinearities are also recorded as midway-point
	intersections. The program only works with active lines.;

INTERNAL SIMPLE PROCEDURE XREF;
	BEGIN "XREF"
	LABEL L200,PSL,BA0;
	INTEGER I1,I2,I3,IV1,IV2,IDUM,IX1,IX2,IP1,IP2,IL,ICV1,ICV2,LCV1,LCV2,
	PS,IT,ISV1,ISV2,LB,IS1,IS2;
	REAL RMLES,RMALSS,RMRLSS,RCDIS,X,Y,R1,R2,RWICS,RX;

_	First prepare the distance tables.;

	LOOP(I1,1,MAXNOV,1) RK[I1]←RAS[I1]←RCOL[I1]←900000.;
	LOOP(I1,1,MAXNOL,1) IF LACT(I1) THEN LINK[2*I1-1]←LINK[2*I1]←0;
	IT←PS←0;
	RX←RMLES←RMLE↑2;
	RMALSS←RMALS↑2;
	RMRLSS←RMRLS↑2;
	RCDIS←RCDI↑2;
	RWICS←RWIC↑2;
_ XREF cont;

_	The following is the MAIN  X-REF SETUP LOOP....;
_	The loop is used three times.

	1: IT=0 PS=0  Regular pass, using RMLE.
	2: IT=1 PS=0  Amending blocked intersections, using RMLE.
	3: IT=0 PS=6  Final pass extension-intersections, using 2*RMLE for sums.;

BA0:	LOOP(I1,1,MAXNOL+IT-1,1)
		BEGIN "LP11" LABEL L11;
		IF ¬LACT(I1)∨RK[ISV1←2*I1]=-1. THEN GO L11;
		IF PS∧ABS LVER[ISV1]≠ISV1∧ABS LVER[ISV1-1]≠ISV1-1
			THEN GO L11;
		IF IT∧¬((ICV1←(ISV2←ABS IPS[ISV1-1])∧
			(RK[ISV2]<RBS[ISV1-1]∨4.0*RCOL[ISV2]<RBS[ISV1-1]))
		     ∨(ICV2←(ISV2←ABS IPS[ISV1])∧
			(RK[ISV2]<RBS[ISV1]∨4.0*RCOL[ISV2]<RBS[ISV1])))
				THEN GO L11;
		IF IT∧ICV1 THEN
			BEGIN
			RAS[ISV1-1]←900000.;
			IPS[ISV1-1]←0
			END;
		IF IT∧ICV2 THEN
			BEGIN
			RAS[ISV1]←900000.;
			IPS[ISV1]←0
			END;
		LB←I1*(1-IT)+1;
		LOOP(I2,LB,MAXNOL,1)
			BEGIN "LP12"
			LABEL L12,L120,L13,L130,L21,L22,L42,L420,L41,
				L32,L31,L310;
			IF I1=I2∨¬LACT(I2)∨RK[ISV2←2*I2]=-1. THEN GO L12;
			IF PS∧ABS LVER[ISV2]≠ISV2∧
				ABS LVER[ISV2-1]≠ISV2-1 THEN GO L12;
_ XREF cont;

_			Both lines are active.;
_			Find intersection (or collinear equivalent).;

L13:			IDUM←KARN(XLCOR[ISV1-1],YLCOR[ISV1-1],
				XLCOR[ISV1],YLCOR[ISV1], XLCOR[ISV2-1],
				YLCOR[ISV2-1],XLCOR[ISV2],YLCOR[ISV2],
				X,Y,IX1,IX2,IP1,IP2,R1,R2,0,RWIC);
			IF IDUM<-1 THEN
				BEGIN
				RK[IV1←IF IDUM=-2 THEN ISV1
					ELSE ISV2]←-1.;
				RK[IV1-1]←-1.;
				GO L12
				END;
			IF PS∧(IP1≤0∨IP2≤0) THEN GO L12;
			IF IT∧(IP1≤0∨IP2≤0∨IP1=1∧¬ICV1∨IP1=2∧¬ICV2)
				THEN GO L12;

_			IVN are the closest s.v:s.;

L130:			IV1←ISV1+ ABS IP1 -2;
			IV2←ISV2+ ABS IP2 -2;
			IF PS∧(ABS LVER[IV1]≠IV1∨ABS LVER[IV2]≠IV2)
				THEN GO L12;
			IF IT+PS∧(R1>RK[IV1]∨R2>RK[IV2]∨R1>4.0*RCOL[IV1]∨
				R2>4.0*RCOL[IV2]) THEN GO L12;

_			Record collinearity iff IDUM=-1 and there is no
			previous entry or the present distance is smaller.;

			IF ¬(IT+PS)∧(IDUM=-1∧R1<RCOL[IV1]∧R1<RCOL[IV2])
				THEN BEGIN
				LINK[IV1]←IV2;
				LINK[IV2]←IV1;
				RCOL[IV1]←RCOL[IV2]←R1;
		                END;

_			Here is where we separate the different cases.;

			IF IP1>0 THEN GO L22;
			IF IP1=0 THEN GO L12;

_			IP1 ← 0 iff lines do not intersect.;

L21:			IF IP2≤0 THEN GO L31 ELSE GO L32;
_ XREF cont;
_			IP2 ≠ 0, always if IP1 ≠ 0.;

L22:			IF IP2≤0 THEN GO L41;

_			IP1 > 0 and IP2 > 0.;

L42:			IF ¬PS∧(R1>RX∨R2>RX)∨PS∧R1+R2>RX THEN GO L12;

_			Extensions are OK.;

			IF R1≥RAS[IV1] THEN GO L420;

_			New minimum for first line, save.
			Collinear case remembered as negative sign of IPS.;

			RAS[IV1]←R1;
			RBS[IV1]←R2;
			IPS[IV1]←ISIGN(IV2,IDUM);
L420:			IF IT∨R2≥RAS[IV2] THEN GO L12;

_			New minimum for second line, save.
			Collinear case remembered as negative sign of IPS.;

			RAS[IV2]←R2;
			RBS[IV2]←R1;
			IPS[IV2]←ISIGN(IV1,IDUM);
			GO L12;

_			IP1 > 0 and IP2 < 0.;

L41:			IF R1≥RK[IV1] THEN GO L12;

_			New minimum distance to crossing line, for line 1.;

			RK[IV1]←R1;
			RBK[IV1]←R2;
			IPK[IV1]←IV2;
			GO L12;

_			IP1 < 0 and IP2 > 0.;

L32:			IF R2≥RK[IV2] THEN GO L12;

_			New minimum distance to crossing line, for line 2.;

			RK[IV2]←R2;
			RBK[IV2]←R1;
			IPK[IV2]←IV1;
			GO L12;
_ XREF cont;

_			IP1 <0 and IP2 < 0. Lines cross. Shorten one
			of them to get the case of a T-joint. Then use
			stopping cases above. Note that this case is
			only presumed possible just after the initial
			line-fit, not later.;

L31:			IDUM←(IF R1>R2 THEN IV2 ELSE IV1);
			XVCOR[LVERCO[IDUM]]←X;
			YVCOR[LVERCO[IDUM]]←Y;
			IF R1>R2 THEN GO L310;
			R1←0.;
			IP1←-IP1;
			GO L41;

L310:			R2←0.;
			IP2←-IP2;
			GO L32;

_			CHECK FOR PARALLELITY MAY BE IMPLEMENTED HERE LATER.;

L12:	; 	_	Inner loop ends...;

L120:                   END "LP12";

_		Outer loop ends...;

L11:	        END "LP11";

_	Iterate once, in order to (possibly) replace blocked intersections.;

	IF ¬(IT+PS) THEN BEGIN IT←1; GO BA0 END;
_ XREF cont;

_	   *****   CROSS-REFERENCE TABLES NOW EXIST   *****;

_	Now create temporary vertices and possible T-joints.
	The indexing is in the s.v. structure [line-ends].
	First pass:  Join acceptable extension-intersections, using RMLE/2.
	Second pass: Same, except use RMLE.
	Third pass:  Join ends with small cut stops, iff either end is free,
		     giving preference to shortest RK of line-pair.
	Fourth pass: Same, except no preference.
	Fifth pass:  Join still free ends into closest vertices,
		     provided distance and PLDIS are OK.
	Sixth pass:  Iterate extension intersections once more, using
			2*RMLE for sums.;

	IF ¬PS THEN BEGIN PS←1; RX←RMLES*0.25; IT←0 END;
PSL:	LOOP(I1,1,MAXNOV,1)
		BEGIN "LP101" LABEL L101,L1020,L1010;
		IF ¬LACT(IL←(I1+1)%2)∨RK[I1]=-1.∨PS≥5∧ABS LVER[I1]≠I1
			THEN GO L101;
		IF PS=3∨PS=4 THEN GO L1010;

_		Line is active. If first, second or sixth pass, check if
		there is an extension-intersection (restore IPS,
		if second pass, while taking care to remember it to MERCV).
		If fifth pass, check for junctions of free lines to vertices.;

		IF PS=5 THEN
			BEGIN
			R1←900000.;
			ICV1←LVERCO[IP2←LVOPP(I1)];
			LCV1←LVERCO[I1];
			LOOP(I2,1,MAXNOV,1) IF I2≠LCV1∧I2≠ICV1∧BELCRE(I2)
				THEN BEGIN
				PLDIS(XVCOR[I2],YVCOR[I2],IL,X,Y,R2,IP1);
				IF IP1=1∧R2<2.*RWICS
					∧(R2←(XLCOR[I1]-X)↑2+
						(YLCOR[I1]-Y)↑2)<R1
					∧R2<(XLCOR[IP2]-X)↑2+(YLCOR[IP2]-Y)↑2
						THEN BEGIN R1←R2; ICV2←I2 END
				END;
			IF R1<RX∧(R1<RK[I1]∨LVERCO[IPK[I1]]=ICV2) THEN
				MERCV(LCV1,ICV2,0);
			GO L101
			END;

		I2←(IPS[I1]<0);
		I3←ABS IPS[I1];
		IF PS=2 THEN IPS[I1]←I3;
		IF RAS[I1]>RX∨RBS[I1]>RX∨RK[I1]<RAS[I1] THEN GO L101;
_ XREF cont;
_		There are no stopping lines in between the two lines, an
		intersection is listed, and the second line is eligible.
		Therefore sofar OK to join the c.v:s of the two lines in
		a temporary compound vertex, i.e. topologically. The
		c.v:s created here are highly temporary in nature, and
		will be subject to change, as the process reaches higher
		stages.;

L1020:		ICV1←LVERCO[I1];
		ICV2←LVERCO[I3];
		IF ¬((IS1←ABS LVER[I1]=I1)
			∧(IS2←ABS LVER[I3]=I3))
		    ∧(IS1
			∧ABS LDIST(XVCOR[ICV2],YVCOR[ICV2],IL)>RWIC
			∨IS2
			∧ABS LDIST(XVCOR[ICV1],YVCOR[ICV1],(I3+1)%2)>RWIC
			∨¬IS1
			∧¬IS2
			∧(XVCOR[ICV1]-XVCOR[ICV2])↑2+
			   (YVCOR[ICV1]-YVCOR[ICV2])↑2>RCDIS) THEN GO L101;

_		The distance between a non-single c.v. and the other c.v.
		or line is OK. Therefore join the c.v:s.;

		IDUM←MERCV(ICV1,ICV2,I2);
		GO L101;

_		Register stopping line as possible T?;

L1010:		IF RK[I1]≥900000. THEN GO L101;

_		Yes, there is a stopping line.;

		LTJOIN[I1]←-((I2←IPK[I1])+1)%2;

_		Register as intersection, i.e. merge, as well?;

		IF (I3← ABS LVER[I1]≠I1)
			∧ ABS LVER[I2]≠I2
			∨ I3∧PS=3
			∧RK[I1]≥RK[I2]
			∨ RK[I1]>RMLES
			∨RBK[I1]>RMALSS
			∨RBK[I1]>RMRLSS*RLEN[(I2+1)%2]↑2 THEN GO L101;
_ XREF cont;
_		At least one end is free, the distance is OK,
		and the cut is small enough. Merge the c.v:s.;

		LCV1←LVERCO[I1];
		LCV2←LVERCO[IPK[I1]];
		IDUM←MERCV(LCV1,LCV2,0);

_		End of primary c.v.-joining loop...;

L101:	        END "LP101";

	RX←IF PS=1 THEN RMLES ELSE IF PS=4 THEN 2.*RMLES ELSE 4.*RMLES;
	IF (PS←PS+1)<6 THEN GO PSL;
	IF PS=6 THEN GO BA0;

_	   *****   PRIMARY C.V. COUMPOUNDS NOW EXIST   *****;

_	OK, by now all the intersection-indicated c.v:s are created.
	The next step is to merge neighbouring c.v:s, provided they
	are within the maximum distance, CDI, from one another, and
	that a line between them would not cross any other line in
	the topological picture.;

L200:	LOOP(I1,1,MAXNOV-1,1)
		BEGIN "LP201" LABEL L201;

_		C.v. is active?;

		IF ¬BELCRE(I1) THEN GO L201;
		LOOP(I2,I1+1,MAXNOV,1)
			BEGIN "LP202" LABEL L202;

_			Second c.v. is active, as well?;

			IF ¬BELCRE(I2) THEN GO L202;

_			Yes, it	 is. Are they close enough?;

			IF (XVCOR[I1]-XVCOR[I2])↑2+
				(YVCOR[I1]-YVCOR[I2])↑2>RCDIS THEN GO L202;

_			Yes, they are. Do they have a line in common?;

			IF LCOMCV(I1,I2)≠0 THEN GO L202;

_			No, they don't. Are they both single?;

			IF NLINCV(-I1)*NLINCV(-I2)=1 THEN GO L202;
_ XREF cont;
_			No, they aren't. Does their line-of-sight cross
			any line, in the TOPOLOGICAL picture? Check all
			active lines!;

		 	LOOP(I3,1,MAXNOV,2)
				BEGIN "LP203" LABEL L203;

_				Is the line active?;

				IF ¬LACT((I3+1)%2) THEN GO L203;

_				Yes, it is. Find end c.v:s.;

				ICV1←LVERCO[I3];
				ICV2←LVERCO[I3+1];

_				Does the line belong to our two c.v:s?;

				IF (I1-ICV1)*(I1-ICV2)*(I2-ICV1)*
					(I2-ICV2)=0 THEN GO L203;

_				No, it doesn't. Check intersection.;

				IDUM←KARN(XVCOR[I1],YVCOR[I1],XVCOR[I2]
					,YVCOR[I2],XVCOR[ICV1],YVCOR[ICV1]
					,XVCOR[ICV2],YVCOR[ICV2],X,Y,IX1
					,IX2,IP1,IP2,R1,R2,0,RWIC);

_				If the lines cross, we lose. Try next
					second c.v.;

				IF IP1<0∧IP2<0 THEN GO L202;

_				The lines do not cross. Check the next one.;

L203:		 	        END "LP203";

_			All lines are cleared. Merge I1 and I2.;

			IF IDUM←MERCV(I1,I2,0) THEN GO L200;

_			After a merge, unfortunately, it is necessary to
			iterate all the way back (now or later), but on
			the other hand it won't happen very often!;
		_	End of inner final-merge loop...;

L202:			END "LP202";

_		End of outer final-merge loop...;

L201:		END "LP201";
_ XREF cont;

_	Finally check collinearities. Negate links between all active,
	unjoined s.v:s where there are unjoined	crossing lines in between.
	Delete unreciprocated links.;

	LOOP(I1,1,MAXNOV,1)
	   IF LACT(IL←(I1+1)%2)
	      ∧(I2←ABS LINK[I1]) THEN
	   IF ABS LINK[I2]≠I1 THEN LINK[I1]←0 ELSE
	   IF I2>I1
		∧LVERCO[I1]≠LVERCO[I2]
		∧(IPK[I1]
		∧RK[I1]<(R1←4*RCOL[I1])
		∧LVERCO[I1]≠LVERCO[IPK[I1]]
		∨IPK[I2]
		∧RK[I2]<R1
		∧LVERCO[I2]≠LVERCO[IPK[I2]])
			THEN BEGIN LINK[I1]←-I2; LINK[I2]←-I1 END;
	END "XREF";
_ UNXREF;

_	This procedure disconnects all active lines from each other.
	It assumes no inactive lines are connected to c.v.s containing
	active lines.;

INTERNAL SIMPLE PROCEDURE UNXREF;
	BEGIN "UNXREF"
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		IB←2*IA;
		LOOP(IC,0,1,1)
			BEGIN
			LVER[ID←IB-IC]←ID;
			RETCV(LVERCO[ID]);
			SVANG[ID]←360.;
			END
		END;
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		IB←2*IA;
		LOOP(IC,0,1,1)
			BEGIN
			IE ← NEXVER;
			ID←IB-IC;
			LVERSI[IE]←ID;
			LVERCO[ID]←IE;
			XVCOR[IE]←XLCOR[ID];
			YVCOR[IE]←YLCOR[ID]
			END
		END;
	END "UNXREF";

END "SCENE";